home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / MPW_TOOL / TOOLS / TOOLS_WI / ICON_8 / H_FOLDER / RT.H < prev    next >
Text File  |  1990-03-02  |  32KB  |  1,098 lines
  1. /*
  2.  * Definitions and declarations used throughout the run-time system.
  3.  * These are also used by the linker in constructing data for use by
  4.  * the run-time system.
  5.  */
  6.  
  7. #ifdef StandardC
  8. #include <time.h>
  9. #endif                    /* StandardC */
  10. #include "::h:cpuconf.h"
  11. #include "::h:memsize.h"
  12.  
  13. /*
  14.  * Constants that are not likely to vary between implementations.
  15.  */
  16.  
  17. #define BitOffMask (IntBits-1)
  18. #define CsetSize (256/IntBits)    /* number of ints to hold 256 cset
  19.                  *  bits. Use (256/IntBits)+1 if
  20.                  *  256 % IntBits != 0 */
  21. #define MinListSlots        8    /* number of elements in an expansion
  22.                  * list element block  */
  23.  
  24. #define MaxCvtLen       257    /* largest string in conversions; the extra
  25.                  *  one is for a terminating null */
  26. #define MaxReadStr       512    /* largest string to read() in one piece */
  27. #define MaxIn          32767    /* largest number of bytes to read() at once */
  28. #define RandA        1103515245    /* random seed multiplier */
  29. #define RandC          453816694    /* random seed additive constant */
  30. #define RanScale 4.65661286e-10    /* random scale factor = 1/(2^31-1)) */
  31.  
  32. /*
  33.  * File status flags in status field of file blocks.
  34.  */
  35. #define Fs_Read         01    /* read access */
  36. #define Fs_Write     02    /* write access */
  37. #define Fs_Create     04    /* file created on open */
  38. #define Fs_Append    010    /* append mode */
  39. #define Fs_Pipe        020    /* reading/writing on a pipe */
  40.  
  41. /*
  42.  * Definitions for interpreter actions.
  43.  */
  44. #define A_Failure    1        /* routine failed */
  45. #define A_Suspension    2        /* routine suspended */
  46. #define A_Return    3        /* routine returned */
  47. #define A_Pret_uw    4        /* interp unwind for Op_Pret */
  48. #define A_Unmark_uw    5        /* interp unwind for Op_Unmark */
  49. #define A_Resumption    6        /* resume generator */
  50. #define A_Pfail_uw    7        /* interp unwind for Op_Pfail */
  51. #define A_Lsusp_uw    8        /* interp unwind for Op_Lsusp */
  52. #define A_Eret_uw    9        /* interp unwind for Op_Eret */
  53. #define A_Coact        10        /* co-expression activated */
  54. #define A_Coret        11        /* co-expression returned */
  55. #define A_Cofail    12        /* co-expression failed */
  56.  
  57. /*
  58.  * Codes returned by invoke to indicate action.
  59.  */
  60. #define I_Builtin    201    /* A built-in routine is to be invoked */
  61. #define I_Fail        202    /* goal-directed evaluation failed */
  62. #define I_Continue    203    /* Continue execution in the interp loop */
  63. #define I_Vararg    204    /* A function with a variable number of args */
  64.  
  65. /*
  66.  * Codes returned by runtime support routines.
  67.  *  Note, some conversion routines also return type codes. Other routines may
  68.  *  return positive values other than return codes. sort() places restrictions
  69.  *  on Less, Equal, and Greater.
  70.  */
  71. #define Less        -1
  72. #define Equal        0
  73. #define Greater        1
  74. #define CvtFail        -2
  75. #define Cvt        -3
  76. #define NoCvt        -4
  77. #define Failure        -5
  78. #define Defaulted    -6
  79. #define Success        -7
  80. #define Error        -8
  81.  
  82. /*
  83.  * Generator types.
  84.  */
  85. #define G_Csusp        1
  86. #define G_Esusp        2
  87. #define G_Psusp        3
  88.  
  89. /*
  90.  * Type codes (descriptors and blocks).
  91.  */
  92. #define T_Null         0    /* null value */
  93. #define T_Integer     1    /* integer */
  94.  
  95. #ifdef LargeInts
  96. #define T_Bignum     2    /* long integer */
  97. #endif                    /* LargeInts */
  98.  
  99. #define T_Real         3    /* real number */
  100. #define T_Cset         4    /* cset */
  101. #define T_File         5    /* file */
  102. #define T_Proc         6    /* procedure */
  103. #define T_List         7    /* list header */
  104. #define T_Table         8    /* table header */
  105. #define T_Record     9    /* record */
  106. #define T_Telem        10    /* table element */
  107. #define T_Lelem        11    /* list element */
  108. #define T_Tvsubs    12    /* substring trapped variable */
  109. #define T_Tvkywd    13    /* keyword trapped variable */
  110. #define T_Tvtbl        14    /* table element trapped variable */
  111. #define T_Set        15    /* set header */
  112. #define T_Selem        16    /* set element */
  113. #define T_Refresh    17    /* refresh block */
  114. #define T_Coexpr    18    /* co-expression */
  115. #define T_External    19    /* external block */
  116. #define T_Slots        20    /* set/table hash slots */
  117.  
  118. #define MaxType        20    /* maximum type number */
  119.  
  120. /*
  121.  * Descriptor types and flags.
  122.  */
  123.  
  124. #define D_Null        (word)(T_Null | F_Nqual)
  125. #define D_Integer    (word)(T_Integer | F_Nqual)
  126.  
  127. #ifdef LargeInts
  128. #define D_Bignum    (word)(T_Bignum | F_Ptr | F_Nqual)
  129. #endif                    /* LargeInts */
  130.  
  131. #define D_Real        (word)(T_Real | F_Ptr | F_Nqual)
  132. #define D_Cset        (word)(T_Cset | F_Ptr | F_Nqual)
  133. #define D_File        (word)(T_File | F_Ptr | F_Nqual)
  134. #define D_Proc        (word)(T_Proc | F_Ptr | F_Nqual)
  135. #define D_List        (word)(T_List | F_Ptr | F_Nqual)
  136. #define D_Table        (word)(T_Table | F_Ptr | F_Nqual)
  137. #define D_Telem        (word)(T_Telem | F_Ptr | F_Nqual)
  138. #define D_Tvsubs    (word)(T_Tvsubs | D_Tvar)
  139. #define D_Tvkywd    (word)(T_Tvkywd | D_Tvar)
  140. #define D_Tvtbl        (word)(T_Tvtbl | D_Tvar)
  141. #define D_Record    (word)(T_Record | F_Ptr | F_Nqual)
  142. #define D_Set        (word)(T_Set | F_Ptr | F_Nqual)
  143. #define D_Refresh    (word)(T_Refresh | F_Ptr | F_Nqual)
  144. #define D_Coexpr    (word)(T_Coexpr | F_Ptr | F_Nqual)
  145. #define D_External    (word)(T_External | F_Ptr | F_Nqual)
  146. #define D_Slots        (word)(T_Slots | F_Ptr | F_Nqual)
  147.  
  148. #define D_Var        (word)(F_Var | F_Nqual | F_Ptr)
  149. #define D_Tvar        (word)(D_Var | F_Tvar)
  150.  
  151. #define TypeMask    63    /* type mask */
  152. #define OffsetMask    (~(D_Tvar)) /* offset mask for variables */
  153.  
  154. /*
  155.  * Run-time data structures.
  156.  */
  157.  
  158. /*
  159.  * Icode consists of operators and arguments.  Operators are small integers,
  160.  *  while arguments may be pointers.  To conserve space in icode files on
  161.  *  computers with 16-bit ints, icode is written by the linker as a mixture
  162.  *  of ints and words (longs).  When an icode file is read in and processed
  163.  *  by the interpreter, it looks like a C array of mixed ints and words.
  164.  *  Accessing this "nonstandard" structure is handled by a union of int and
  165.  *  word pointers and incrementing is done by incrementing the appropriate
  166.  *  member of the union (see the interpreter).  This is a rather dubious
  167.  *  method and certainly not portable.  A better way might be to address
  168.  *  icode with a char *, but the incrementing code might be inefficient
  169.  *  (at a place that experiences a lot of execution activity).
  170.  *
  171.  * For the moment, the dubious coding is isolated under control of the
  172.  *  size of integers.
  173.  */
  174.  
  175. #if IntBits == 16
  176.  
  177. typedef union {
  178.    int *op;
  179.    word *opnd;
  180.    } inst;
  181.  
  182. #else                    /* IntBits == 16 */
  183.  
  184. typedef union {
  185.    word *op;
  186.    word *opnd;
  187.    } inst;
  188.  
  189. #endif                    /* IntBits == 16 */
  190.  
  191. /*
  192.  * Descriptor
  193.  */
  194.  
  195. struct descrip {        /* descriptor */
  196.    word dword;            /*   type field */
  197.    union {
  198.       word integr;        /*   integer value */
  199.       char *sptr;        /*   pointer to character string */
  200.       union block *bptr;    /*   pointer to a block */
  201.       dptr descptr;        /*   pointer to a descriptor */
  202.       } vword;
  203.    };
  204.  
  205. struct sdescrip {
  206.    word length;            /*   length of string */
  207.    char *string;        /*   pointer to string */
  208.    };
  209.  
  210. /*
  211.  * Run-time error numbers and text.
  212.  */
  213. struct errtab {
  214.    int err_no;            /* error number */
  215.    char *errmsg;        /* error message */
  216.    };
  217.  
  218. /*
  219.  * Frame markers
  220.  */
  221. struct ef_marker {        /* expression frame marker */
  222.    inst ef_failure;        /*   failure ipc */
  223.    struct ef_marker *ef_efp;    /*   efp */
  224.    struct gf_marker *ef_gfp;    /*   gfp */
  225.    word ef_ilevel;        /*   ilevel */
  226.    };
  227.  
  228. struct pf_marker {        /* procedure frame marker */
  229.    word pf_nargs;        /*   number of arguments */
  230.    struct pf_marker *pf_pfp;    /*   saved pfp */
  231.    struct ef_marker *pf_efp;    /*   saved efp */
  232.    struct gf_marker *pf_gfp;    /*   saved gfp */
  233.    dptr pf_argp;        /*   saved argp */
  234.    inst pf_ipc;            /*   saved ipc */
  235.    word pf_ilevel;        /*   saved ilevel */
  236.    dptr pf_scan;        /*   saved scanning environment */
  237.    struct descrip pf_locals[1];    /*   descriptors for locals */
  238.    };
  239.  
  240. struct gf_marker {        /* generator frame marker */
  241.    word gf_gentype;        /*   type */
  242.    struct ef_marker *gf_efp;    /*   efp */
  243.    struct gf_marker *gf_gfp;    /*   gfp */
  244.    inst gf_ipc;            /*   ipc */
  245.    struct pf_marker *gf_pfp;    /*   pfp */
  246.    dptr gf_argp;        /*   argp */
  247.    };
  248.  
  249. /*
  250.  * Generator frame marker dummy -- used only for sizing "small"
  251.  *  generator frames where procedure infomation need not be saved.
  252.  *  The first five members here *must* be identical to those for
  253.  *  gf_marker.
  254.  */
  255. struct gf_smallmarker {        /* generator frame marker */
  256.    word gf_gentype;        /*   type */
  257.    struct ef_marker *gf_efp;    /*   efp */
  258.    struct gf_marker *gf_gfp;    /*   gfp */
  259.    inst gf_ipc;            /*   ipc */
  260.    };
  261.  
  262. #ifdef LargeInts
  263.  
  264. typedef unsigned int DIGIT;
  265.  
  266. struct b_bignum {        /* large integer block */
  267.    word title;            /*   T_Bignum */
  268.    word blksize;        /*   block size */
  269.    word msd, lsd;        /*   most and least significant digits */
  270.    int sign;            /*   sign; 0 positive, 1 negative */
  271.    DIGIT digits[1];        /*   digits */
  272.    };
  273.  
  274. #endif                    /* LargeInts */
  275. struct b_real {            /* real block */
  276.    word title;            /*   T_Real */
  277.    double realval;        /*   value */
  278.    };
  279.  
  280. struct b_cset {            /* cset block */
  281.    word title;            /*   T_Cset */
  282.    word size;            /*   size of cset */
  283.    int bits[CsetSize];        /*   array of bits */
  284.    };
  285.  
  286. struct b_file {            /* file block */
  287.    word title;            /*   T_File */
  288.    FILE *fd;            /*   Unix file descriptor */
  289.    word status;            /*   file status */
  290.    struct descrip fname;    /*   file name (string qualifier) */
  291.    };
  292.  
  293. struct b_proc {            /* procedure block */
  294.    word title;            /*   T_Proc */
  295.    word blksize;        /*   size of block */
  296.    union {            /*   entry points for */
  297.       int (*ccode)();        /*     C routines */
  298.       uword ioff;        /*     and icode as offset */
  299.       pointer icode;        /*     and icode as absolute pointer */
  300.       } entryp;
  301.    word nparam;            /*   number of parameters */
  302.    word ndynam;            /*   number of dynamic locals */
  303.    word nstatic;        /*   number of static locals */
  304.    word fstatic;        /*   index (in global table) of first static */
  305.    struct descrip pname;    /*   procedure name (string qualifier) */
  306.    struct descrip lnames[1];    /*   list of local names (qualifiers) */
  307.    };
  308.  
  309. /*
  310.  * b_iproc blocks are used to statically initialize information about
  311.  *  functions.    They are identical to b_proc blocks except for
  312.  *  the pname field which is a sdecrip (simple/string descriptor) instead
  313.  *  of a descrip.  This is done because unions cannot be initialized.
  314.  */
  315.     
  316. struct b_iproc {        /* procedure block */
  317.    word ip_title;        /*   T_Proc */
  318.    word ip_blksize;        /*   size of block */
  319.    int (*ip_entryp)();        /*   entry point (code) */
  320.    word ip_nparam;        /*   number of parameters */
  321.    word ip_ndynam;        /*   number of dynamic locals */
  322.    word ip_nstatic;        /*   number of static locals */
  323.    word ip_fstatic;        /*   index (in global table) of first static */
  324.    struct sdescrip ip_pname;    /*   procedure name (string qualifier) */
  325.    struct descrip ip_lnames[1];    /*   list of local names (qualifiers) */
  326.    };
  327.  
  328. struct b_list {            /* list-header block */
  329.    word title;            /*   T_List */
  330.    word size;            /*   current list size */
  331.    word id;            /*   identification number */
  332.    union block *listhead;    /*   pointer to first list-element block */
  333.    union block *listtail;    /*   pointer to last list-element block */
  334.    };
  335.  
  336. struct b_lelem {        /* list-element block */
  337.    word title;            /*   T_Lelem */
  338.    word blksize;        /*   size of block */
  339.    union block *listprev;    /*   previous list-element block */
  340.    union block *listnext;    /*   next list-element block */
  341.    word nslots;            /*   total number of slots */
  342.    word first;            /*   index of first used slot */
  343.    word nused;            /*   number of used slots */
  344.    struct descrip lslots[1];    /*   array of slots */
  345.    };
  346.  
  347. struct b_slots {        /* set/table hash slots */
  348.    word title;            /*   T_Slots */
  349.    word blksize;        /*   size of block */
  350.    union block *hslots[HSlots];    /*   array of slots (HSlots * 2^n entries) */
  351.    };
  352.  
  353. struct b_table {        /* table-header block */
  354.    word title;            /*   T_Table */
  355.    word size;            /*   current table size */
  356.    word id;            /*   identification number */
  357.    word mask;            /*   mask to get slot num, equals n slots - 1 */
  358.    struct b_slots *hdir[HSegs];    /*   directory of hash slot segments */
  359.    struct descrip defvalue;    /*   default table element value */
  360.    };
  361.  
  362. struct b_telem {        /* table-element block */
  363.    word title;            /*   T_Telem */
  364.    union block *clink;        /*   hash chain link */
  365.    uword hashnum;        /*   for ordering chain */
  366.    struct descrip tref;        /*   entry value */
  367.    struct descrip tval;        /*   assigned value */
  368.    };
  369.  
  370. /*
  371.  * A set header must be a proper prefix of a table header,
  372.  *  and a set element must be a proper prefix of a table element.
  373.  */
  374. struct b_set {            /* set-header block */
  375.    word title;            /*   T_Set */
  376.    word size;            /*   size of the set */
  377.    word id;            /*   identification number */
  378.    word mask;            /*   mask to get slot num, equals n slots - 1 */
  379.    struct b_slots *hdir[HSegs];    /*   directory of hash slot segments */
  380.    };
  381.  
  382. struct b_selem {        /* set-element block */
  383.    word title;            /*   T_Selem */
  384.    union block *clink;        /*   hash chain link */
  385.    uword hashnum;        /*   hash number */
  386.    struct descrip setmem;    /*   the element */
  387.    };
  388.  
  389. struct b_record {        /* record block */
  390.    word title;            /*   T_Record */
  391.    word blksize;        /*   size of block */
  392.    word id;            /*   identification number */
  393.    union block *recdesc;    /*   pointer to record constructor */
  394.    struct descrip fields[1];    /*   fields */
  395.    };
  396.  
  397. /*
  398.  * Alternate uses for procedure block fields, applied to records.
  399.  */
  400. #define nfields    nparam        /* number of fields */
  401. #define recnum nstatic        /* record number */
  402. #define recid fstatic        /* record serial number */
  403. #define recname    pname        /* record name */
  404.  
  405. struct b_tvkywd {        /* keyword trapped variable block */
  406.    word title;            /*   T_Tvkywd */
  407.    int (*putval)();        /*   assignment function for keyword */
  408.    struct descrip kyval;    /*   keyword value */
  409.    struct descrip kyname;    /*   keyword name */
  410.    };
  411.  
  412. struct b_tvsubs {        /* substring trapped variable block */
  413.    word title;            /*   T_Tvsubs */
  414.    word sslen;            /*   length of substring */
  415.    word sspos;            /*   position of substring */
  416.    struct descrip ssvar;    /*   variable that substring is from */
  417.    };
  418.  
  419. struct b_tvtbl {        /* table element trapped variable block */
  420.    word title;            /*   T_Tvtbl */
  421.    union block *clink;        /*   pointer to table header block */
  422.    uword hashnum;        /*   hash number */
  423.    struct descrip tref;        /*   entry value */
  424.    struct descrip tval;        /*   reserved for assigned value */
  425.    };
  426.  
  427. struct b_coexpr {        /* co-expression stack block */
  428.    word title;            /*   T_Coexpr */
  429.    word size;            /*   number of results produced */
  430.    word id;            /*   identification number */
  431.    struct b_coexpr *nextstk;    /*   pointer to next allocated stack */
  432.    struct pf_marker *es_pfp;    /*   current pfp */
  433.    struct ef_marker *es_efp;    /*   efp */
  434.    struct gf_marker *es_gfp;    /*   gfp */
  435.    dptr es_argp;        /*   argp */
  436.    inst es_ipc;            /*   ipc */
  437.    word es_ilevel;        /*   interpreter level */
  438.    word *es_sp;            /*   sp */
  439.    dptr tvalloc;        /*   where to place transmitted value */
  440.    struct descrip freshblk;    /*   refresh block pointer */
  441.    struct astkblk *es_actstk;    /*   pointer to activation stack structure */
  442.    word cstate[CStateSize];    /*   C state information */
  443.    };
  444.  
  445. struct astkblk {          /* co-expression activator-stack block */
  446.    int nactivators;          /*   number of valid activator entries in
  447.                    *    this block */
  448.    struct astkblk *astk_nxt;      /*   next activator block */
  449.    struct actrec {          /*   activator record */
  450.       word acount;          /*     number of calls by this activator */
  451.       struct b_coexpr *activator; /*     the activator itself */
  452.       } arec[ActStkBlkEnts];
  453.    };
  454.  
  455. struct b_refresh {        /* co-expression block */
  456.    word title;            /*   T_Refresh */
  457.    word blksize;        /*   size of block */
  458.    word *ep;            /*   entry point */
  459.    word numlocals;        /*   number of locals */
  460.    struct pf_marker pfmkr;    /*   marker for enclosing procedure */
  461.    struct descrip elems[1];    /*   arguments and locals, including Arg0 */
  462.    };
  463.  
  464. struct b_external {        /* external block */
  465.    word title;            /*   T_External */
  466.    word blksize;        /*   size of block */
  467.    word descoff;        /*   offset to first descriptor */
  468.    word exdata[1];        /*   words of external data */
  469.    };
  470.  
  471. union block {            /* general block */
  472.  
  473. #ifdef LargeInts
  474.    struct b_bignum bignumblk;
  475. #endif                    /* LargeInts */
  476.  
  477.    struct b_real realblk;
  478.    struct b_cset cset;
  479.    struct b_file file;
  480.    struct b_proc proc;
  481.    struct b_list list;
  482.    struct b_lelem lelem;
  483.    struct b_table table;
  484.    struct b_telem telem;
  485.    struct b_set set;
  486.    struct b_selem selem;
  487.    struct b_record record;
  488.    struct b_tvkywd tvkywd;
  489.    struct b_tvsubs tvsubs;
  490.    struct b_tvtbl tvtbl;
  491.    struct b_refresh refresh;
  492.    struct b_coexpr coexpr;
  493.    struct b_external externl;
  494.    struct b_slots slots;
  495.    };
  496.  
  497. /*
  498.  * Declarations for entries in tables associating icode location with
  499.  *  source program location.
  500.  */
  501. struct ipc_fname {
  502.    word ipc;        /* offset of instruction into code region */
  503.    word fname;        /* offset of file name into string region */
  504.    };
  505.  
  506. struct ipc_line {
  507.    word ipc;        /* offset of instruction into code region */
  508.    int line;        /* line number */
  509.    };
  510.  
  511. /*
  512.  * External declarations.
  513.  */
  514.  
  515. extern char *code;        /* start of icode */
  516.  
  517. extern word stksize;        /* size of co-expression stacks in words */
  518. extern word *stackend;        /* end of evaluation stack */
  519. extern struct b_coexpr *stklist;/* base of co-expression stack list */
  520.  
  521. extern word mstksize;        /* size of main stack in words */
  522.  
  523. extern char *statbase;        /* start of static space */
  524. extern char *statend;        /* end of static space */
  525. extern char *statfree;        /* static space free list header */
  526. extern word statsize;        /* size of static space */
  527. extern word statincr;        /* size of increment for static space */
  528.  
  529. extern word ssize;        /* size of string space (bytes) */
  530. extern char *strbase;        /* start of string space */
  531. extern char *strend;        /* end of string space */
  532. extern char *strfree;        /* string space free pointer */
  533.  
  534. extern word abrsize;        /* size of allocated block region (words) */
  535. extern char *blkbase;        /* base of allocated block region */
  536. extern char *blkend;        /* maximum address in allocated block region */
  537. extern char *blkfree;        /* first free location in allocated block region */
  538.  
  539. extern int bsizes[];        /* sizes of blocks */
  540. extern int firstd[];        /* offset (words) of first descrip. */
  541. extern char *blkname[];        /* print names for block types. */
  542. extern uword segsize[];        /* size of hash bucket segment */
  543.  
  544.  
  545. extern struct b_tvkywd tvky_err;    /* trapped variable for &error */
  546. extern struct b_tvkywd tvky_pos;    /* trapped variable for &pos */
  547. extern struct b_tvkywd tvky_ran;    /* trapped variable for &random */
  548. extern struct b_tvkywd tvky_sub;    /* trapped variable for &subject */
  549. extern struct b_tvkywd tvky_trc;    /* trapped variable for &trace */
  550.  
  551.  
  552. #define k_error tvky_err.kyval.vword.integr    /* value of &error */
  553. #define k_pos tvky_pos.kyval.vword.integr    /* value of &pos */
  554. #define k_random tvky_ran.kyval.vword.integr    /* value of &random */
  555. #define k_subject tvky_sub.kyval        /* value of &subject */
  556. #define k_trace tvky_trc.kyval.vword.integr    /* value of &trace */
  557.  
  558. extern struct b_cset k_ascii;        /* value of &ascii */
  559. extern struct b_cset k_cset;        /* value of &cset */
  560. extern struct b_cset k_digits;        /* value of &lcase */
  561. extern struct b_file k_errout;        /* value of &errout */
  562. extern struct b_file k_input;        /* value of &input */
  563. extern struct b_cset k_lcase;        /* value of &lcase */
  564. extern struct b_cset k_letters;        /* value of &letters */
  565. extern int k_level;            /* value of &level */
  566. extern char *k_errortext;        /* value of &errortext */
  567. extern int k_errornumber;        /* value of &errornumber */
  568. extern struct descrip k_errorvalue;    /* value of &errorvalue */
  569. extern struct descrip k_main;        /* value of &main */
  570. extern struct descrip k_current;    /* ¤t */
  571. extern struct b_file k_output;        /* value of &output */
  572. extern struct b_cset k_ucase;        /* value of &ucase */
  573.  
  574. #ifdef SASC
  575. extern clock_t starttime;        /* start time in milliseconds */
  576. #else                    /* SASC */
  577. extern long starttime;            /* start time in milliseconds */
  578. #endif                    /* SASC */
  579.  
  580. extern struct descrip nulldesc;        /* null value */
  581. extern struct descrip zerodesc;        /* zero */
  582. extern struct descrip onedesc;        /* one */
  583. extern struct descrip emptystr;        /* empty string */
  584. extern struct descrip blank;        /* blank */
  585. extern struct descrip letr;        /* letter "r" */
  586. extern struct descrip maps2;        /* second argument to map() */
  587. extern struct descrip maps3;        /* third argument to map() */
  588. extern struct descrip input;        /* &input */
  589. extern struct descrip errout;        /* &errout */
  590. extern struct descrip lcase;        /* lowercase string */
  591. extern struct descrip ucase;        /* uppercase string */
  592.  
  593. extern int ntended;        /* number of active tended descriptors */
  594. extern struct descrip tended[];    /* tended descriptors */
  595.  
  596. extern word *sp;        /* interpreter stack pointer */
  597. extern word *stack;        /* interpreter stack base */
  598. extern struct pf_marker *pfp;    /* procedure frame pointer */
  599. extern struct ef_marker *efp;    /* expression frame pointer */
  600. extern struct gf_marker *gfp;    /* generator frame pointer */
  601. extern inst ipc;        /* interpreter program counter */
  602. extern dptr argp;        /* argument pointer */
  603. extern int ilevel;        /* interpreter level */
  604.  
  605. #ifdef ExecImages
  606. extern int dumped;        /* the interpreter has been dumped */
  607. #endif                    /* ExecImages */
  608.  
  609. #if EBCDIC == 2
  610. extern char ToEBCDIC[], FromEBCDIC[]; /* ASCII<->EBCDIC maps */
  611. #define ToAscii(e) (FromEBCDIC[e])
  612. #define FromAscii(e) (ToEBCDIC[e])
  613. #else                    /* EBCDIC == 2 */
  614. #define ToAscii(e) (e)
  615. #define FromAscii(e) (e)
  616. #endif                    /* EBCDIC == 2 */
  617.  
  618.  
  619. /*
  620.  * Evaluation stack overflow margin
  621.  */
  622.  
  623. #define PerilDelta 100
  624.  
  625. /*
  626.  * Macro definitions related to descriptors.
  627.  */
  628.  
  629. /*
  630.  * The following code is operating-system dependent [@rt.01].  Define
  631.  *  PushAval for computers that store longs and pointers differently.
  632.  */
  633.  
  634. #if PORT
  635. #define PushAVal(x) PushVal(x)
  636. Deliberate Syntax Error
  637. #endif                    /* PORT */
  638.  
  639. #if AMIGA || ATARI_ST || HIGHC_386 || MACINTOSH || MVS || UNIX || VM || VMS
  640. #define PushAVal(x) PushVal(x)
  641. #endif                    /* AMIGA || ATARI_ST || HIGHC_386 ... */
  642.  
  643. #if MSDOS || OS2
  644. static union {
  645.        pointer stkadr;
  646.        word stkint;
  647.    } stkword;
  648.  
  649. #define PushAVal(x)  {sp++; \
  650.             stkword.stkadr = (char *)(x); \
  651.             *sp = stkword.stkint;}
  652. #endif                    /* MSDOS || OS2 */
  653.  
  654. /*
  655.  * End of operating-system specific code.
  656.  */
  657.  
  658. /*
  659.  * Pointer to block.
  660.  */
  661. #define BlkLoc(d)    ((d).vword.bptr)
  662.  
  663. /*
  664.  * Check for null-valued descriptor.
  665.  */
  666. #define ChkNull(d)    ((d).dword==D_Null)
  667.  
  668. /*
  669.  * Dereference descriptor.
  670.  */
  671. #define DeRef(d)    (Var(d) ? deref(&d) : Success)
  672.  
  673. /*
  674.  * Check for equivalent descriptors.
  675.  */
  676. #define EqlDesc(d1,d2)    ((d1).dword == (d2).dword && BlkLoc(d1) == BlkLoc(d2))
  677.  
  678. /*
  679.  * Integer value.
  680.  */
  681. #define IntVal(d)    ((d).vword.integr)
  682.  
  683. /*
  684.  * Offset from top of block to value of variable.
  685.  */
  686. #define Offset(d)    ((d).dword & OffsetMask)
  687.  
  688. /*
  689.  * Check for pointer.
  690.  */
  691. #define Pointer(d)    ((d).dword & F_Ptr)
  692.  
  693. /*
  694.  * Check for qualifier.
  695.  */
  696. #define Qual(d)        (!((d).dword & F_Nqual))
  697.  
  698. /*
  699.  * Length of string.
  700.  */
  701. #define StrLen(q)    ((q).dword)
  702.  
  703. /*
  704.  * Location of first character of string.
  705.  */
  706. #define StrLoc(q)    ((q).vword.sptr)
  707.  
  708. /*
  709.  * Check for trapped variable.
  710.  */
  711. #define Tvar(d)        ((d).dword & F_Tvar)
  712.  
  713. /*
  714.  * Location of trapped-variable block.
  715.  */
  716. #define TvarLoc(d)    ((d).vword.bptr)
  717.  
  718. /*
  719.  * Type of descriptor.
  720.  */
  721. #define Type(d)        (int)((d).dword & TypeMask)
  722.  
  723. /*
  724.  * Check for variable.
  725.  */
  726. #define Var(d)        ((d).dword & F_Var)
  727.  
  728. /*
  729.  * Location of the value of a variable.
  730.  */
  731. #define VarLoc(d)    ((d).vword.descptr)
  732.  
  733. /*
  734.  *  Important note:  The code that follows is not strictly legal C.
  735.  *   It tests to see if pointer p2 is between p1 and p3. This may
  736.  *   involve the comparison of pointers in different arrays, which
  737.  *   is not well-defined.  The casts of these pointers to unsigned "words"
  738.  *   (longs or ints, depending) works with all C compilers and architectures
  739.  *   on which Icon has been implemented.  However, it is possible it will
  740.  *   not work on some system.  If it doesn't, there may be a "false
  741.  *   positive" test, which is likely to cause a memory violation or a
  742.  *   loop. It is not practical to implement Icon on a system on which this
  743.  *   happens.
  744.  */
  745.  
  746. #define InRange(p1,p2,p3) ((uword)(p2) >= (uword)(p1) && (uword)(p2) < (uword)(p3))
  747.  
  748. /*
  749.  * Macros for pushing values on the interpreter stack.
  750.  */
  751.  
  752. /*
  753.  * Push descriptor.
  754.  */
  755. #define PushDesc(d)    {*++sp = ((d).dword); sp++;*sp =((d).vword.integr);}
  756.  
  757. /*
  758.  * Push null-valued descriptor.
  759.  */
  760. #define PushNull    {*++sp = D_Null; sp++; *sp = 0;}
  761.  
  762. /*
  763.  * Push word.
  764.  */
  765. #define PushVal(v)    {*++sp = (word)(v);}
  766.  
  767. /*
  768.  * Macros related to function and operator definition.
  769.  */
  770.  
  771. /*
  772.  * Procedure block for a function.
  773.  */
  774.  
  775. #define FncBlock(f,nargs,deref) \
  776.     struct b_iproc Cat(B,f) = {\
  777.     T_Proc,\
  778.     Vsizeof(struct b_proc),\
  779.     Cat(X,f),\
  780.     nargs,\
  781.     -1,\
  782.     deref, 0,\
  783.     {sizeof(Lit(f))-1,Lit(f)}};
  784.  
  785.  
  786. /*
  787.  * Function declaration for variable number of arguments.
  788.  */
  789. #define FncDcl(nm,n) FncBlock(nm,n,0) Cat(X,nm)(cargp)  register dptr cargp;
  790.  
  791. /*
  792.  * Function declaration for variable number of arguments.
  793.  */
  794. #define FncDclV(nm) FncBlock(nm,-1,0) Cat(X,nm)(nargs,cargp) register dptr cargp;
  795.  
  796. /*
  797.  * Function declaration without dereferenced arguments.
  798.  */
  799. #define FncNDcl(nm,n) FncBlock(nm,n,-1) Cat(X,nm)(cargp)  register dptr cargp;
  800.  
  801. /*
  802.  * Function declaration for variable number of arguments.
  803.  */
  804. #define FncNDclV(nm) FncBlock(nm,-1,-1) Cat(X,nm)(nargs,cargp) register dptr cargp;
  805.  
  806. /*
  807.  * Declaration for library routine.
  808.  */
  809. #define LibDcl(nm,n,pn) OpBlock(nm,n,pn,0) Cat(O,nm)(nargs,cargp) \
  810.    register dptr cargp;
  811. /*
  812.  * Procedure block for an operator.
  813.  */
  814. #define OpBlock(f,nargs,sname,realargs)\
  815.     struct b_iproc Cat(B,f) = {\
  816.     T_Proc,\
  817.     Vsizeof(struct b_proc),\
  818.     Cat(O,f),\
  819.     nargs,\
  820.     -1,\
  821.     realargs,\
  822.     0,\
  823.     {sizeof(sname)-1,sname}};
  824.  
  825. /*
  826.  * Operator declaration.
  827.  */
  828. #define OpDcl(nm,n,pn) OpBlock(nm,n,pn,0) Cat(O,nm)(cargp) register dptr cargp;
  829.  
  830. /*
  831.  * Agent routine declaration.
  832.  */
  833. #define AgtDcl(nm) Cat(A,nm)(cargp) register dptr cargp;
  834.  
  835. #ifdef StrInvoke
  836. /*
  837.  * Structure for mapping string names of procedures to block addresses.
  838.  */
  839. struct pstrnm {
  840.    char *pstrep;
  841.    struct b_proc *pblock;
  842.    };
  843. #endif                    /* StrInvoke */
  844.  
  845. /*
  846.  * Macros to access Icon arguments in C functions.
  847.  */
  848.  
  849. /*
  850.  * n-th argument.
  851.  */
  852. #define Arg(n)         (cargp[n])
  853.  
  854. /*
  855.  * Type field of n-th argument.
  856.  */
  857. #define ArgType(n)    (cargp[n].dword)
  858.  
  859. /*
  860.  * Value field of n-th argument.
  861.  */
  862. #define ArgVal(n)    (cargp[n].vword.integr)
  863.  
  864. /*
  865.  * Specific arguments.
  866.  */
  867. #define Arg0    (cargp[0])
  868. #define Arg1    (cargp[1])
  869. #define Arg2    (cargp[2])
  870. #define Arg3    (cargp[3])
  871. #define Arg4    (cargp[4])
  872. #define Arg5    (cargp[5])
  873. #define Arg6    (cargp[6])
  874.  
  875. /*
  876.  * Code expansions for exits from C code for top-level routines.
  877.  */
  878. #define Fail        return A_Failure
  879. #define Return        return A_Return
  880.  
  881. #define Suspend  { \
  882.    int rc; \
  883.    if ((rc = interp(G_Csusp,cargp)) != A_Resumption) \
  884.       return rc;} 
  885.  
  886. #define Forward(agent) return Cat(A,agent)(cargp)
  887.  
  888. /*
  889.  * Miscellaneous macro definitions.
  890.  */
  891.  
  892. /*
  893.  * Error exit from non top-level routines.
  894.  */
  895. #define RetError(n,v) {\
  896.    k_errornumber = n;\
  897.    k_errortext = "";\
  898.    k_errorvalue = v;\
  899.    return Error;}
  900.  
  901. /*
  902.  * Get floating-point number from real block.
  903.  */
  904. #ifdef Double
  905. #define GetReal(dp,res)    { \
  906.                          word *rp, *rq; \
  907.                          rp = (word *) &(res); \
  908.                          rq = (word *) &(BlkLoc(*dp)->realblk.realval); \
  909.                          *rp++ = *rq++; \
  910.                          *rp = *rq;} 
  911. #else                    /* Double */
  912. #define GetReal(dp,res)    res = BlkLoc(*dp)->realblk.realval
  913. #endif                    /* Double */
  914.  
  915. /*
  916.  * Absolute value of x (word).
  917.  */
  918. #define Abs(x)        (((x) < 0) ? (-(x)) : (x))
  919.  
  920. /*
  921.  * Maximum of x and y.
  922.  */
  923. #define Max(x,y)        ((x)>(y)?(x):(y))
  924. #ifdef SASC        /* remove comments for Relase 4.50 */
  925. /* #undef Max */
  926. /* #define Max(x,y)     __builtin_max(x,y)      */
  927. #endif                    /* SASC */
  928.  
  929. /*
  930.  * Minimum of x and y.
  931.  */
  932. #define Min(x,y)        ((x)<(y)?(x):(y))
  933. #ifdef SASC        /* remove comments for Relase 4.50 */
  934. /* #undef Min */
  935. /* #define Min(x,y)     __builtin_min(x,y)      */
  936. #endif                    /* SASC */
  937.  
  938. /*
  939.  * Some C compilers take '\n' and '\r' to be the same, so the
  940.  *  following definitions are used.
  941.  */
  942. #if EBCDIC
  943. /*
  944.  * Note that, in EBCDIC, "line feed" and "new line" are distinct
  945.  *  characters.  Icon's use of "line feed" is really "new line" in
  946.  *  C terms.
  947.  */
  948. #define LineFeed '\n' /* if really "line feed", that's 37 */
  949. #define CarriageReturn '\r'
  950. #else                    /* EBCDIC */
  951. #define LineFeed  10
  952. #define CarriageReturn 13
  953. #endif                    /* EBCDIC */
  954.  
  955. /*
  956.  * Construct an integer descriptor.
  957.  */
  958. #define MakeInt(i,dp)    { \
  959.                       (dp)->dword = D_Integer; \
  960.                          IntVal(*dp) = (word)(i);}
  961.  
  962. /*
  963.  * Check whether a set or table needs resizing.
  964.  */
  965. #define SP(p) ((struct b_set *)p)
  966. #define TooCrowded(p) \
  967.    ((SP(p)->size > MaxHLoad*(SP(p)->mask+1)) && (SP(p)->hdir[HSegs-1] == NULL))
  968. #define TooSparse(p) \
  969.    ((SP(p)->hdir[1] != NULL) && (SP(p)->size < MinHLoad*(SP(p)->mask+1)))
  970.  
  971. /*
  972.  * RunErr encapsulates a call to the function runerr, followed
  973.  *  by Fail.  The idea is to avoid the problem of calling
  974.  *  runerr directly and forgetting that it may actually return.
  975.  */
  976.  
  977. #define RunErr(n,dp) {\
  978.    runerr((int)n,dp);\
  979.    Fail;\
  980.    }
  981.  
  982. /*
  983.  *  Vsizeof is for use with variable-sized (i.e., indefinite)
  984.  *   structures containing an array of descriptors declared of size 1
  985.  *   to avoid compiler warnings associated with 0-sized arrays.
  986.  */
  987.  
  988. #define Vsizeof(s)    (sizeof(s) - sizeof(struct descrip))
  989.  
  990. /*
  991.  * Offset in word of cset bit.
  992.  */
  993. #define CsetOff(b)    ((b) & BitOffMask) 
  994. /*
  995.  * Address of word of cset bit.
  996.  */
  997. #define CsetPtr(b,c)    ((c) + (((b)&0377) >> LogIntBits)) 
  998. /*
  999.  * Set bit b in cset c.
  1000.  */
  1001. #define Setb(b,c)    (*CsetPtr(b,c) |= (01 << CsetOff(b))) 
  1002. /*
  1003.  * Test bit b in cset c.
  1004.  */
  1005. #define Testb(b,c)    ((*CsetPtr(b,c) >> CsetOff(b)) & 01) 
  1006.  
  1007. /*
  1008.  * Handy sizeof macros:
  1009.  *
  1010.  *  Wsizeof(x)    -- Size of x in words.
  1011.  *  Vwsizeof(x) -- Size of x in words, minus the size of a descriptor.    Used
  1012.  *   when structures have a potentially null list of descriptors
  1013.  *   at their end.
  1014.  */
  1015. #define Wsizeof(x)    ((sizeof(x) + sizeof(word) - 1) / sizeof(word))
  1016. #define Vwsizeof(x)    ((sizeof(x) - sizeof(struct descrip) +sizeof(word) - 1)\
  1017.                / sizeof(word))
  1018. /*
  1019.  * Definitions and declarations used for storage management.
  1020.  */
  1021.  
  1022. #define F_Mark        0100000     /* bit for marking blocks */
  1023.  
  1024. #define Static  1            /* collection is for static region */
  1025. #define Strings    2            /* collection is for strings */
  1026. #define Blocks    3            /* collection is for blocks */
  1027.  
  1028. /*
  1029.  * External definitions.
  1030.  */
  1031.  
  1032. extern char *currend;            /* current end of memory region */
  1033. extern uword blkneed;            /* stated need for block space */
  1034. extern uword strneed;            /* stated need for string space */
  1035. extern uword statneed;
  1036. extern dptr globals;             /* start of global variables */
  1037. extern dptr eglobals;            /* end of global variables */
  1038. extern dptr gnames;            /* start of global variable names */
  1039. extern dptr egnames;             /* end of global variable names */
  1040. extern dptr statics;             /* start of static variables */
  1041. extern dptr estatics;            /* end of static variables */
  1042.  
  1043. extern dptr *quallist;            /* start of qualifier list */
  1044. extern word qualsize;
  1045.  
  1046. /*
  1047.  * Get type of block pointed at by x.
  1048.  */
  1049. #define BlkType(x)   (*(word *)x)
  1050.  
  1051. /*
  1052.  * BlkSize(x) takes the block pointed to by x and if the size of
  1053.  *  the block as indicated by bsizes[] is nonzero it returns the
  1054.  *  indicated size; otherwise it returns the second word in the
  1055.  *  block contains the size.
  1056.  */
  1057. #define BlkSize(x) (bsizes[*(word *)x & ~F_Mark] ? \
  1058.              bsizes[*(word *)x & ~F_Mark] : *((word *)x + 1))
  1059.  
  1060. /*
  1061.  * If memory monitoring is not enabled, redefine function calls
  1062.  * to do nothing.
  1063.  */
  1064. #ifndef MemMon
  1065. #define MMAlc(n,t)
  1066. #define MMBGC(r)
  1067. #define MMEGC()
  1068. #define MMMark(b,t)
  1069. #define MMShow(d,s)
  1070. #define MMStat(a,l,c)
  1071. #define MMStr(n)
  1072. #define MMSMark(a,n)
  1073. #endif                    /* MemMon */
  1074.  
  1075. #ifndef FixedRegions
  1076.  
  1077. /*
  1078.  * Information used with Icon's allocation routines with expandable-regions
  1079.  *  memory management.
  1080.  */
  1081.  
  1082. typedef int ALIGN;        /* pick most stringent type for alignment */
  1083.  
  1084. union bhead {            /* header of free block */
  1085.    struct {
  1086.       union bhead *ptr;     /* pointer to next free block */
  1087.       uword bsize;        /* free block size */
  1088.       } s;
  1089.    ALIGN x;            /* force block alignment */
  1090.    };
  1091.  
  1092. typedef union bhead HEADER;
  1093. #define NALLOC 64        /* units to request at one time */
  1094.  
  1095. #define FREEMAGIC 0x807F    /* magic flag for free blocks (MemMon only) */
  1096.  
  1097. #endif                    /* FixedRegions */
  1098.